Developer CD Series 1996 May: Tool Chest/Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso/Tool Chest/Development Tools & Languages/Dylan Related/Mindy/Mindy 1.2 - portable sources/interp/buf.c

C/C++ Source or Header | 1995-03-15 | 4.8 KB | 178 lines | [TEXT/ttxt]

/**********************************************************************\
*
*  Copyright (c) 1994  Carnegie Mellon University
*  All rights reserved.
*
*  Use and copying of this software and preparation of derivative
*  works based on this software are permitted, including commercial
*  use, provided that the following conditions are observed:
*
*  1. This copyright notice must be retained in full on any copies
*     and on appropriate parts of any derivative works.
*  2. Documentation (paper or online) accompanying any system that
*     incorporates this software, or any part of it, must acknowledge
*     the contribution of the Gwydion Project at Carnegie Mellon
*     University.
*
*  This software is made available "as is".  Neither the authors nor
*  Carnegie Mellon University make any warranty about the software,
*  its performance, or its conformity to any specification.
*
*  Bug reports, questions, comments, and suggestions should be sent by
*  E-mail to the Internet address "[e-mail]".
*
***********************************************************************
*
* $Header: buf.c,v 1.11 94/11/29 06:43:02 wlott Exp $
*
* This file implements buffers, a special byte vector used by streams.
*
\**********************************************************************/

#include "../compat/std-c.h"

#include "mindy.h"
#include "gc.h"
#include "coll.h"
#include "class.h"
#include "module.h"
#include "num.h"
#include "bool.h"
#include "obj.h"
#include "error.h"
#include "list.h"
#include "def.h"
#include "sym.h"
#include "type.h"
#include "vec.h"
#include "str.h"
#include "buf.h"

#define max(a,b) ((a)>(b) ? (a) : (b))

obj_t obj_BufferClass = NULL;

static obj_t dylan_buffer_make(obj_t class, obj_t size)
{
    int len;
    obj_t res;

    len = fixnum_value(check_type(size, obj_FixnumClass));

    if (len < 0)
    error("Bogus size: for make %=: %d", class, size);

    res = alloc(obj_BufferClass, sizeof(struct buffer)
      + max(len - sizeof(((struct buffer *)res)->data),
        sizeof(((struct buffer *)res)->data)));

    obj_ptr(struct buffer *, res)->length = len;

    return res;
}

static obj_t dylan_buffer_size(obj_t buffer)
{
    return make_fixnum(obj_ptr(struct buffer *, buffer)->length);
}

static obj_t dylan_buffer_element(obj_t buffer, obj_t index, obj_t def)
{
    int i = fixnum_value(index);

    if (0 <= i && i < obj_ptr(struct buffer *, buffer)->length)
    return make_fixnum(buffer_data(buffer)[i]);
    else if (def != obj_Unbound)
    return def;
    else {
    error("No element %= in %=", index, buffer);
    return NULL;
    }
}

static obj_t dylan_buffer_element_setter(obj_t val, obj_t buffer, obj_t index)
{
    int i = fixnum_value(index);

    if (0 <= i && i < obj_ptr(struct buffer *, buffer)->length)
    buffer_data(buffer)[i] = fixnum_value(val);
    else
    error("No element %= in %=", index, buffer);

    return val;
}

static obj_t dylan_memcpy(obj_t dst, obj_t dst_off, obj_t src, obj_t src_off,
              obj_t count)
{
    memmove(buffer_data(dst) + fixnum_value(dst_off),
        buffer_data(src) + fixnum_value(src_off),
        fixnum_value(count));
    return dst;
}


/* GC stuff. */

static int scav_buffer(struct object *ptr)
{
    struct buffer *buffer = (struct buffer *)ptr;

    return sizeof(struct buffer) + max(buffer->length - sizeof(buffer->data),
                       sizeof(buffer->data));
}

static obj_t trans_buffer(obj_t buffer)
{
    return transport(buffer,
             sizeof(struct buffer)
             + max(obj_ptr(struct buffer *, buffer)->length
               - sizeof(((struct buffer *)buffer)->data),
               sizeof(((struct buffer *)buffer)->data)));
}

void scavenge_buffer_roots(void)
{
    scavenge(&obj_BufferClass);
}



/* Init stuff. */

void make_buffer_classes(void)
{
    obj_BufferClass = make_builtin_class(scav_buffer, trans_buffer);
}

void init_buffer_classes(void)
{
    init_builtin_class(obj_BufferClass, "<buffer>", obj_VectorClass, NULL);
}

void init_buffer_functions(void)
{
    obj_t u;

    define_method("element", list2(obj_BufferClass, obj_FixnumClass),
          FALSE, list1(pair(symbol("default"), obj_Unbound)), FALSE,
          obj_FixnumClass, dylan_buffer_element);
    define_method("element-setter",
          list3(obj_FixnumClass, obj_BufferClass,
            obj_FixnumClass),
          FALSE, obj_False, FALSE, obj_ObjectClass,
          dylan_buffer_element_setter);
    define_method("size", list1(obj_BufferClass), FALSE, obj_False, FALSE,
          obj_FixnumClass, dylan_buffer_size);
    define_method("make", list1(singleton(obj_BufferClass)), FALSE,
          list1(pair(symbol("size"), make_fixnum(4096))),
          FALSE, obj_BufferClass, dylan_buffer_make);

    u = type_union(obj_ByteStringClass, obj_ByteVectorClass);
    u = type_union(u, obj_BufferClass);
    define_method("copy-bytes",
          listn(5, u, obj_FixnumClass, u,
            obj_FixnumClass, obj_FixnumClass),
          FALSE, obj_False, FALSE, u, dylan_memcpy);
}